home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok44 / m2ced / txt / m2ced.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  422 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    M2CED.mod
  4.     :Contents.   Working with CED
  5.     :Author.     Steffen Reith
  6.     :Address.    Hessenstr. 64, D-8700 Würzburg
  7.     :Copyright.  Shareware
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga A+L V3.2d
  10.     :Imports.    ARP, CED, ErrorMsg, Errors, Keys, req, Msg, Config
  11.     :History.    V1.0  9.June 1990
  12.                  V1.1  12.June 1990 Some bugs fixed
  13.                  V1.2  18.June 1990 Configuration added
  14.                  V1.21 10.July 1990 little changes in Compile and Link
  15.  
  16. **********************************************************************)
  17. (* $S- $F- $N- $R- $V- *)
  18. MODULE M2CED;
  19.  
  20. FROM Arp         IMPORT SyncRun,GADS;
  21. FROM Arts        IMPORT dosCmdBuf,dosCmdLen;
  22. FROM CED         IMPORT Fehler,FehlerType,Status,PutMsg2CED,TalkCED,KillString;
  23. FROM ErrorMsg    IMPORT ReadList,KillList,FindMsg,String,NodePtr;
  24. FROM Errors      IMPORT ExistErrorFile,OpenErrorFile,NextError,CloseErrorFile,
  25.                         ErrorFeld;
  26. FROM Keys        IMPORT KeyPressed,Action;
  27. FROM req         IMPORT DSize,FChars,PathTypePtr,PathType,GetString;
  28. FROM Intuition   IMPORT DisplayBeep,WBenchToFront;
  29. FROM SYSTEM      IMPORT ADDRESS,ADR;
  30. FROM Dos         IMPORT FileHandle,FileHandlePtr,Open,Close,newFile,Delay,
  31.                         readWrite,oldFile,Write,Execute,CurrentDir,FileLockPtr,
  32.                         Lock,UnLock,sharedLock;
  33. FROM Str         IMPORT Concat,Compare,Length;
  34. FROM Conversions IMPORT ValToStr;
  35. FROM Msg         IMPORT TitleMsg,Request;
  36. FROM Config      IMPORT P,Para,WriteFile,ReadFile;
  37.  
  38. CONST ExtLen=4; (* Laenge der Namensextension *)
  39.       Template='N=NameOnly/s,A=Argument/s,R=NoRestart/s';
  40.       HelpMsg='Usage: M2CED [nur Filename] [Argument erfragen] [NoRestart]';
  41.       CopyRightMsgC=' M2CED V1.21 © by Steffen Reith is activ ';
  42.  
  43. TYPE ExtType=ARRAY[0..ExtLen] OF CHAR; (* Laenge nur fuer M2-Amiga geeignet *)
  44.      Sort=(FullPath,NameOnly);
  45.      BOOLEANPtr=POINTER TO BOOLEAN;
  46.      ArgType=RECORD
  47.               NameO,Argument,NoRestart:BOOLEANPtr
  48.              END;
  49.      DosWin=ARRAY[0..63] OF CHAR;
  50.  
  51. VAR Root:NodePtr;
  52.     Key:CARDINAL;
  53.     StartArgument:ARRAY[0..255] OF CHAR;
  54.     CopyRightMsg:ARRAY[0..63] OF CHAR;
  55.     Flag,ErrorsOn:BOOLEAN;
  56.     Argc:INTEGER;
  57.     Arg:ArgType;
  58.     Old:FileLockPtr;
  59.     OldFile,OpenName:PathType;
  60.     Compiled:BOOLEAN;
  61.  
  62. PROCEDURE ReportCEDError();
  63.  
  64. VAR Text:ARRAY[0..31] OF CHAR;
  65.  
  66. BEGIN
  67.  CASE Fehler OF
  68.   |ok:Text:='Internal FATAL Error';
  69.   |noReply:Text:='Keine Replyport';
  70.   |noCED:Text:='Kein CED da !!!!';
  71.  END;
  72.  Request(Text)
  73. END ReportCEDError;
  74.  
  75. PROCEDURE Cont();
  76.  
  77. VAR Erg:Action;
  78.  
  79. BEGIN
  80.  REPEAT
  81.   Erg:=KeyPressed()
  82.  UNTIL Erg=continue
  83. END Cont;
  84.  
  85. PROCEDURE ChangeDir(VAR Dir:ARRAY OF CHAR);
  86.  
  87. VAR MyLock:FileLockPtr;
  88.     Msg:ARRAY[0..31] OF CHAR;
  89.  
  90. BEGIN
  91.  MyLock:=Lock(ADR(Dir),sharedLock);
  92.  IF MyLock=NIL THEN
  93.   Msg:='Kann Directory nicht wechseln!';
  94.   TitleMsg(Msg);
  95.   RETURN
  96.  END;
  97.  MyLock:=CurrentDir(MyLock);
  98.  UnLock(MyLock)
  99. END ChangeDir;
  100.  
  101. PROCEDURE GetCEDFileExtension(VAR Ext:ExtType);
  102.  
  103. VAR Flag:BOOLEAN;
  104.     Help:PathType;
  105.     i:INTEGER;
  106.  
  107. BEGIN
  108.  
  109.  Flag:=TalkCED('Status 21'); (* Filenamen ohne Pfad *)
  110.  IF NOT(Flag) THEN
  111.   ReportCEDError();
  112.   RETURN
  113.  END;
  114.  
  115.  Help:=Status^;
  116.  i:=0;
  117.  WHILE (Help[i]#'.') AND (i<FChars+DSize) DO INC(i) END; (* Nach . suchen *)
  118.  IF i=FChars+DSize THEN Ext:=''; RETURN END;
  119.  Ext[0]:=Help[i]; Ext[1]:=Help[i+1];
  120.  Ext[2]:=Help[i+2]; Ext[3]:=Help[i+3]; Ext[4]:=CHAR(0);
  121.  KillString(Status)
  122. END GetCEDFileExtension;
  123.  
  124. PROCEDURE GetCEDFileName(VAR Name:PathType;PathSort:Sort);
  125.  
  126. VAR Flag:BOOLEAN;
  127.     i:INTEGER;
  128.     Help:PathType;
  129.  
  130. BEGIN
  131.  Name:='';
  132.  Help:='Status ';
  133.  IF PathSort=FullPath THEN
  134.   Concat(Help,'19')
  135.  ELSE
  136.   Concat(Help,'21')
  137.  END;
  138.  
  139.  Flag:=TalkCED(Help);
  140.  IF NOT (Flag) THEN
  141.   ReportCEDError();
  142.   RETURN
  143.  END;
  144.  
  145.  Help:=Status^;
  146.  i:=0;
  147.  WHILE (i<(1+FChars+DSize)) AND (Help[i]#'.') DO INC(i) END;
  148.  Help[i]:=CHAR(0);
  149.  Name:=Help;
  150.  KillString(Status)
  151. END GetCEDFileName;
  152.  
  153. PROCEDURE NameLen(Ptr:ADDRESS):INTEGER; (* Wird benoetigt weil CED oft   *)
  154.                                         (* keine nullterminierte Strings *)
  155. TYPE IntPtr=POINTER TO LONGINT;         (* zurueckliefert                *)
  156.  
  157. VAR IPtr:IntPtr;
  158.  
  159. BEGIN
  160.  IPtr:=Ptr;
  161.  DEC(IPtr,4);
  162.  RETURN IPtr^
  163. END NameLen;
  164.  
  165. PROCEDURE GetCEDPath(VAR Path:PathType);
  166.  
  167. VAR i:INTEGER;
  168.     Help:PathType;
  169.  
  170. BEGIN
  171.  Path:='';
  172.  
  173.  Help:='Status 19';
  174.  Flag:=TalkCED(Help);
  175.  IF NOT (Flag) THEN
  176.   ReportCEDError();
  177.   RETURN
  178.  END;
  179.  
  180.  Help:=Status^;
  181.  i:=NameLen(Status);
  182.  WHILE (Help[i]#'/') AND (Help[i]#':') AND (i>0) DO DEC(i) END;
  183.  IF Help[i]=':' THEN
  184.   Help[i+1]:=CHAR(0)
  185.  ELSE
  186.   Help[i]:=CHAR(0)
  187.  END;
  188.  Path:=Help;
  189.  KillString(Status)
  190. END GetCEDPath;
  191.  
  192. PROCEDURE LoadErrors();
  193.  
  194. VAR Name,Name2:PathType;
  195.     Ext:ExtType;
  196.     i:CARDINAL;
  197.  
  198. BEGIN
  199.  CloseErrorFile();
  200.  ErrorsOn:=TRUE;
  201.  GetCEDFileName(Name,FullPath);
  202.  GetCEDFileExtension(Ext);Concat(Name,Ext);
  203.  Concat(Name,'e');
  204.  IF NOT(ExistErrorFile(Name)) THEN
  205.   Name:='txt/'; (* Arbeitet jemand mit txt-Dirs ??? *)
  206.   GetCEDFileName(Name2,NameOnly);
  207.   Concat(Name,Name2);Concat(Name,Ext);Concat(Name,'e');
  208.   IF NOT(ExistErrorFile(Name)) THEN
  209.    TitleMsg('Kann kein Errorfile finden ');
  210.    ErrorsOn:=FALSE;
  211.    RETURN
  212.   END
  213.  END;
  214.  OpenErrorFile(Name)
  215. END LoadErrors;
  216.  
  217. PROCEDURE FindErrors();
  218.  
  219. CONST IntLen=10;
  220.       KommandLen=20;
  221.  
  222. VAR SourcePos:LONGCARD;
  223.     i:INTEGER;
  224.     ErrorNums:ErrorFeld;
  225.     PosStr:ARRAY[0..IntLen] OF CHAR;
  226.     Msg:ARRAY[0..KommandLen] OF CHAR;
  227.     ErrMsg,OutTxt:String;
  228.     err,Flag:BOOLEAN;
  229.  
  230. BEGIN
  231.  IF ErrorsOn THEN
  232.   NextError(SourcePos,ErrorNums);
  233.   IF (SourcePos=0) AND (ErrorNums[1]=0) THEN
  234.    CloseErrorFile();
  235.    ErrorsOn:=FALSE;
  236.    TitleMsg('Kein (weiterer) Fehler gefunden');
  237.    Flag:=PutMsg2CED('Jump To Byte 0');
  238.    RETURN
  239.   END;
  240.  
  241.   ValToStr(SourcePos,FALSE,PosStr,10,-1*SIZE(PosStr),CHAR(0),err);
  242.   IF err THEN
  243.    TitleMsg('Interner Fataler Fehler I');DisplayBeep(NIL);Delay(50);RETURN;
  244.   END;
  245.   Msg:='Jump To Byte ';Concat(Msg,PosStr);
  246.   Flag:=PutMsg2CED(Msg);
  247.   IF NOT(Flag) THEN
  248.    PosStr:='0';
  249.    ReportCEDError()
  250.   END;
  251.  
  252.   i:=1;
  253.   OutTxt:='';
  254.   WHILE ErrorNums[i]#0 DO
  255.    FindMsg(Root,ErrorNums[i],ErrMsg);
  256.    Concat(OutTxt,ErrMsg);
  257.    Concat(OutTxt,' ');
  258.    INC(i)
  259.   END;
  260.   TitleMsg(OutTxt);
  261.  END
  262. END FindErrors;
  263.  
  264. PROCEDURE Compile(VAR Compiled:BOOLEAN);
  265.  
  266. VAR Name,Name2,Name3:PathType;
  267.     Dummy:LONGINT;
  268.     out,help:FileHandlePtr;
  269.     Kommando:ARRAY [0..DSize+FChars+5] OF CHAR;
  270.     Flag,ChgDir:BOOLEAN;
  271.     Ext:ExtType;
  272.     Title:DosWin;
  273.  
  274. BEGIN
  275.  ErrorsOn:=FALSE;
  276.  CloseErrorFile();
  277.  Flag:=PutMsg2CED('Save all Changes');
  278.  
  279.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2C Compiling ...');
  280.  out:=Open(ADR(Title),newFile);
  281.  
  282.  Kommando:='m2c -d ';
  283.  IF (Argc>0) AND (Arg.NameO^) THEN
  284.   GetCEDPath(Name);
  285.   ChangeDir(Name); (* Compile im aktuellen Dir laufen lassen ! *)
  286.   GetCEDFileName(Name,NameOnly);
  287.  ELSE
  288.   GetCEDFileName(Name,FullPath)
  289.  END;
  290.  Concat(Kommando,Name);
  291.  GetCEDFileExtension(Ext);
  292.  IF NOT(Arg.NoRestart^) THEN (* Restartfile schreiben ?? *)
  293.   GetCEDFileName(Name3,FullPath);Concat(Name3,Ext);
  294.   WriteFile(Name3) (* Fuer Neustart *)
  295.  END;
  296.  
  297.  IF (Compare(Ext,'.def')=0) THEN Concat(Kommando,Ext) END;
  298.  Flag:=WBenchToFront();
  299.  Dummy:=Execute(ADR(Kommando),NIL,out);
  300.  
  301.  (* Name normale Fehlerdatei Name2 Fehlerdatei in TXT Dir *)
  302.  Concat(Name,Ext);Concat(Name,'e');
  303.  GetCEDFileName(Name3,NameOnly);
  304.  Name2:='txt/';
  305.  Concat(Name2,Name3);Concat(Name2,Ext);Concat(Name2,'e');
  306.  IF ExistErrorFile(Name) OR ExistErrorFile(Name2) THEN  (* Festellen ob Fehler*)
  307.   Dummy:=Write(out,ADR(Para.ContMsg),SIZE(Para.ContMsg));
  308.   Cont();
  309.   Flag:=PutMsg2CED('CEDToFront');
  310.   LoadErrors();
  311.   FindErrors()
  312.  ELSE
  313.   Flag:=PutMsg2CED('CEDToFront');
  314.   Compiled:=TRUE (* Compiler ist ohne Fehler durchgelaufen *)
  315.  END;
  316.  Close(out)
  317. END Compile;
  318.  
  319. PROCEDURE Link(VAR Compiled:BOOLEAN);
  320.  
  321. VAR Name:PathType;
  322.     Dummy:LONGINT;
  323.     out:FileHandlePtr;
  324.     Kommando:ARRAY [0..DSize+FChars+5] OF CHAR;
  325.     Flag:BOOLEAN;
  326.     Ext:ExtType;
  327.     Title:DosWin;
  328.  
  329. BEGIN
  330.  ErrorsOn:=FALSE;
  331.  CloseErrorFile();
  332.  GetCEDFileName(Name,NameOnly);
  333.  
  334.  GetCEDFileExtension(Ext);
  335.  IF (Compare(Ext,'.def')=0) THEN
  336.   TitleMsg('.DEF Files koennen nicht gelinkt werden !!!');
  337.   RETURN
  338.  END;
  339.  
  340.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2L Linking ...');
  341.  out:=Open(ADR(Title),newFile);
  342.  Kommando:='m2l ';Concat(Kommando,Name);
  343.  Flag:=WBenchToFront();
  344.  Dummy:=Execute(ADR(Kommando),NIL,out);
  345.  Delay(25); (* Noch warten *)
  346.  Flag:=PutMsg2CED('CEDToFront');
  347.  Close(out);
  348.  IF NOT(Compiled) THEN
  349.   TitleMsg('Warning: Compiler war vor dem Linker nicht aktiv !!')
  350.  END;
  351.  Compiled:=FALSE;
  352. END Link;
  353.  
  354. PROCEDURE Start();
  355.  
  356. VAR Name:PathType;
  357.     Dummy:LONGINT;
  358.     Flag,Enter:BOOLEAN;
  359.     inout:FileHandlePtr;
  360.     Title:DosWin;
  361.  
  362. BEGIN
  363.  ErrorsOn:=FALSE;
  364.  CloseErrorFile();
  365.  GetCEDFileName(Name,NameOnly);
  366.  Flag:=WBenchToFront();
  367.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2 Executing ...');
  368.  inout:=Open(ADR(Title),readWrite);
  369.  IF Arg.Argument^ THEN
  370.   Enter:=GetString(ADR(StartArgument),ADR('Argument ?'),NIL,20,
  371.                    SIZE(StartArgument)-1);
  372.   IF NOT(Enter) THEN StartArgument:='' END;
  373.   Dummy:=SyncRun(ADR(Name),ADR(StartArgument),inout,inout);
  374.  ELSE
  375.   Dummy:=SyncRun(ADR(Name),NIL,inout,inout);
  376.  END;
  377.  Dummy:=Write(inout,ADR(Para.ContMsg),SIZE(Para.ContMsg));
  378.  Cont();
  379.  Close(inout);
  380.  Flag:=PutMsg2CED('CEDToFront');
  381. END Start;
  382.  
  383. BEGIN
  384.  Argc:=GADS(dosCmdBuf,dosCmdLen,ADR(HelpMsg),ADR(Arg),ADR(Template));
  385.  StartArgument:='';
  386.  
  387.  ReadList(Root);
  388.  
  389.  ErrorsOn:=FALSE;
  390.  Flag:=PutMsg2CED('CEDToFront');
  391.  IF NOT Flag THEN ReportCEDError() END;
  392.  
  393.  IF NOT(Arg.NoRestart^) THEN
  394.   ReadFile(OldFile); (* evtl. altes File laden *)
  395.   OpenName:='Open ';
  396.   Concat(OpenName,OldFile)
  397.  ELSE
  398.   OpenName:='Open'
  399.  END;
  400.  Flag:=PutMsg2CED(OpenName);
  401.  
  402.  Delay(25);
  403.  CopyRightMsg:=CopyRightMsgC;
  404.  TitleMsg(CopyRightMsg);
  405.  
  406.  Compiled:=FALSE; (* Flag ob Compiler vor Linker gelaufen ist *)
  407.  
  408.  LOOP
  409.   CASE KeyPressed() OF
  410.    |compile:Compile(Compiled);
  411.    |link:Link(Compiled);
  412.    |start:Start();
  413.    |findError:FindErrors();
  414.    |load:LoadErrors();
  415.    |cancel:DisplayBeep(NIL);EXIT;
  416.   ELSE
  417.   END
  418.  END;
  419.  
  420.  KillList(Root);
  421. END M2CED.
  422.